perm filename QBALL.SAI[CRE,BGB] blob
sn#072774 filedate 1974-05-31 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00020 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 BEGIN "QBALL"
C00004 00003 α QUE-BALLS
C00006 00004 α FILE OPENING & SIZE
C00008 00005 SUBR LSCAM (ITG V1,V2,V3) α CAMERA LOCUS SOLVER
C00010 00006 REAL SUBR CAMERR α CAMERA LOCUS ERROR
C00013 00007 SUBR MKROT1
C00015 00008 PROCEDURE MKROT2 (ITG V1,V2,V3)
C00018 00009 SUBR PROJECT
C00019 00010 SUBR UNPROJECT(REAL FOCAL)
C00020 00011 SUBR SHOW
C00022 00012 α CRE LINKS & DATUMS
C00024 00013 SUBR INERTIA
C00027 00014 SUBR ESTIMATE
C00029 00015 SUBR PDPY (ITG PGN) α POLYGON DISPLAY
C00031 00016 SUBR FDPY α FILM DISPLAY
C00032 00017 SUBR ORBINIT(REAL RAD) α WORLD LOCUS OF THE QUEUE BALLS
C00033 00018 α MAIN EXECUTION
C00034 00019 WHILE TRUE DO
C00036 00020 WHILE TRUE DO
C00038 ENDMK
C⊗;
BEGIN "QBALL"
REQUIRE "ABBREV[SYS,BGB]" SOURCE_FILE;
REQUIRE "SAITRG[SYS,BGB]" SOURCE_FILE;
REQUIRE "DPYIII[SYS,BGB]" SOURCE_FILE;
SAFE ITG ARRAY DPYBUF[0:4000];
α CAMERA;
REAL PAN,TILT,SWING; α CAMERA ORIENTATION;
REAL CX,CY,CZ; α CAMERA LOCATION;
REAL PDX,PDY,FOCAL; α PIXEL SIZE & LENS FOCAL LENGTH;
REAL ASPECT,EFOCAL;
REAL RPA,CPA; α IMAGE LOCUS OF PRINCIPLE RAY;
REAL IX,IY,IZ;
REAL JX,JY,JZ;
REAL KX,KY,KZ;
REAL ARRAY CLX,CLY,CLZ,CLQ[1:32]; α CAMERA LOCUS SOLUTIONS;
INTEGER CAMCNT;
α QUE-BALLS;
INTEGER QCNT;
REAL ARRAY XWC,YWC,ZWC[1:32]; α WORLD COORDINATES;
REAL ARRAY XCC,YCC,ZCC[1:32]; α PREDICTED CAMERA COORDINATES;
REAL ARRAY XCF,YCF,ZCF[1:32]; α PERCEIVED CAMERA COORDINATES;
REAL ARRAY XPP,YPP,ZPP[1:32]; α PREDICTED IMAGE COORDINATES;
REAL ARRAY XDC,YDC,ZDC[1:32]; α PREDICTED DISPLAY COORDINATES;
REAL ARRAY PRROW,PRCOL[1:32]; α PERCEIVED ROW & COL;
REAL ARRAY PRXPP,PRYPP[1:32]; α PERCEIVED IMAGE COORDINATES;
REAL ARRAY PRXDC,PRYDC[1:32]; α PERCEIVED DISPLAY COORDINATES;
REAL ARRAY RADIUS[1:32]; α PERCEIVED RADIUS;
ITG ARRAY SNODE[1:32]; α QUE BALL SHAPE NODES;
REAL MAG,ORGX,ORGY;ITG CNT,I;
INTEGER SIZE,ORIG; α NODE SPACE SIZE & ORIGIN;
α ORBIT PARAMETERS;
REAL ORBROW,ORBCOL; α CENTER OF MASS OF ORBIT;
REAL ORBMXX,ORBMYY,ORBPXY;
REAL ORBAREA,ORBARC;
REAL ORBA,ORBB,ORBRAD;
REAL ORBMIN,ORBMAX; α EXTREME RADII OF ORBIT;
α FILE OPENING & SIZE;
REAL C,S;ITG FLG; STRING CREFILE;
OPEN(1,"DSK",8,3,0,0,0,0);
DO ⊂ OUTSTR(9&"CRE FILE = ");
CREFILE ← INCHWL;
LOOKUP(1,CREFILE,FLG);
IF FLG THEN LOOKUP(1,CREFILE&".CRE",FLG);
⊃ UNTIL ¬FLG;
SIZE ← WORDIN(1);
OUTSTR(9&"FILE SIZE = "&CVS(SIZE)&" WORDS."&↓);
BEGIN "MAIN"
ITG ARRAY NODE[0:SIZE];
α IRON TRIANGLE - CAMERA LOCUS SOLVER;
REAL ARRAY P1,P2,P3,COSANG[1:3],V[1:10,1:3];
REQUIRE "LS1V3P.REL[LS,BGB]" LOAD_MODULE;
EXTERNAL ITG PROCEDURE LS1V3P(REAL ARRAY V,P1,P2,P3,COSANG);
REAL SUBR DOTVEC(ITG I,J);
BEGIN "DOTVEC"
REAL X1,Y1,Z1,X2,Y2,Z2,R1,R2,ZCOS;
X1 ← XCF[I]; Y1 ← YCF[I]; Z1 ← ZCF[I];
X2 ← XCF[J]; Y2 ← YCF[J]; Z2 ← ZCF[J];
R1 ← SQRT(X1*X1 + Y1*Y1 + Z1*Z1);
R2 ← SQRT(X2*X2 + Y2*Y2 + Z2*Z2);
ZCOS←(X1*X2 + Y1*Y2 + Z1*Z2) / (R1*R2);
RETURN(ZCOS);
END "DOTVEC";
SUBR LSCAM (ITG V1,V2,V3); α CAMERA LOCUS SOLVER;
BEGIN "LSCAM"
ITG I,J,K,L,M,N;
REAL Q,QMIN;
CAMCNT ← CAMCNT+1;
α IRON TRIANGLE - KNOWN WORLD LOCI;
P1[1]←XWC[V1]; P2[1]←XWC[V3]; P3[1]←XWC[V2];
P1[2]←YWC[V1]; P2[2]←YWC[V3]; P3[2]←YWC[V2];
P1[3]←ZWC[V1]; P2[3]←ZWC[V3]; P3[3]←ZWC[V2];
α IRON TRIPOD - KNOW ANGLES BETWEEN CAMERA RAYS;
COSANG[1] ← DOTVEC(V3,V2);
COSANG[2] ← DOTVEC(V1,V2);
COSANG[3] ← DOTVEC(V1,V3);
α THROW THE SHIT AT THE FAN;
N ← LS1V3P(V,P1,P2,P3,COSANG);
α OUTSTR(CVS(CAMCNT)&↓);
α FIND THE ANSWER CLOSEST TO THE ESTIMATED ANSWER;
QMIN ← 999999;
FOR I←1 THRU N DO
⊂
α OUTSTR(9&CVG(V[I,1])&9&CVG(V[I,2])&9&CVG(V[I,3])&↓);
Q←SQRT((V[I,1]-CX)↑2+(V[I,2]-CY)↑2+(V[I,3]-CZ)↑2);
IF Q≤QMIN THEN ⊂ J←I; QMIN←Q;⊃;⊃;
CLX[CAMCNT] ← V[J,1];
CLY[CAMCNT] ← V[J,2];
CLZ[CAMCNT] ← V[J,3];
END "LSCAM";
REAL SUBR CAMERR; α CAMERA LOCUS ERROR;
BEGIN "CAMERR"
REAL X0,Y0,Z0;
REAL X1,Y1,Z1;
REAL SDX,SDY,SDZ,SD;
INTEGER I,IX,IY,IZ;
α AVERAGE SOLUTION;
X0←Y0←Z0←0;
FOR I←1 THRU CAMCNT DO
⊂ X0←X0+CLX[I];Y0←Y0+CLY[I];Z0←Z0+CLZ[I];⊃;
X1←Y1←Z1←0;
FOR I←1 THRU CAMCNT DO
BEGIN
IF ABS(CLX[I]-X0) > X1 THEN ⊂ IX←I;X1←ABS(CLX[I]-X0);⊃;
IF ABS(CLY[I]-Y0) > Y1 THEN ⊂ IY←I;Y1←ABS(CLY[I]-Y0);⊃;
IF ABS(CLZ[I]-Z0) > Z1 THEN ⊂ IZ←I;Z1←ABS(CLZ[I]-Z0);⊃;
END;
α ELIMINATE THE BIG LOSERS;
CLX[IX]↔CLX[CAMCNT]; CLY[IX]↔CLY[CAMCNT]; CLZ[IX]↔CLZ[CAMCNT];
CAMCNT←CAMCNT-1; IF IY≠IX THEN
⊂ CLX[IY]↔CLX[CAMCNT]; CLY[IY]↔CLY[CAMCNT]; CLZ[IY]↔CLZ[CAMCNT];
CAMCNT←CAMCNT-1;⊃; IF IZ≠IY ∧ IZ≠IX THEN
⊂ CLX[IZ]↔CLX[CAMCNT]; CLY[IZ]↔CLY[CAMCNT]; CLZ[IZ]↔CLZ[CAMCNT];
CAMCNT←CAMCNT-1;⊃;
α AVERAGE SOLUTION;
X0←Y0←Z0←0;
X1←Y1←Z1←0;
FOR I←1 THRU CAMCNT DO
⊂ X0←X0+CLX[I];Y0←Y0+CLY[I];Z0←Z0+CLZ[I];
X1←X1+CLX[I]↑2;Y1←Y1+CLY[I]↑2;Z1←Z1+CLZ[I]↑2;
α OUTSTR(9&CVG(CLX[I])&9&CVG(CLY[I])&9&CVG(CLZ[I])&↓); ⊃;
X0←X0/CAMCNT; Y0←Y0/CAMCNT; Z0←Z0/CAMCNT;
X1←X1/CAMCNT; Y1←Y1/CAMCNT; Z1←Z1/CAMCNT;
α STANDARD DEVIATIONS;
SDX ← SQRT(X1 - X0↑2);SDY ← SQRT(Y1 - Y0↑2);SDZ ← SQRT(Z1 - Z0↑2);
SD ← SQRT(SDX↑2 + SDY↑2 + SDZ↑2);
OUTSTR(9&CVG(X0)&9&CVG(Y0)&9&CVG(Z0)&9&CVG(SD)&↓);
CX ← X0; CY ← Y0; CZ ← Z0;
RETURN(SD);
END "CAMERR";
SUBR MKROT1;
BEGIN "MKROT1"
REAL RR;
REAL C_PAN,S_PAN,C_TILT,S_TILT,C_SWING,S_SWING;
C_PAN ← COS(PAN); S_PAN ← SIN(PAN);
C_TILT ← COS(TILT); S_TILT ← SIN(TILT);
C_SWING ← COS(SWING); S_SWING ← SIN(SWING);
IX ← C_PAN*C_SWING - S_PAN*C_TILT*S_SWING;
IY ← S_PAN*C_SWING + C_PAN*C_TILT*S_SWING;
IZ ← S_TILT*S_SWING;
JX ← -C_PAN*S_SWING - S_PAN*C_TILT*C_SWING;
JY ← -S_PAN*S_SWING + C_PAN*C_TILT*C_SWING;
JZ ← S_TILT*C_SWING;
KX ← S_PAN*S_TILT;
KY ← -C_PAN*S_TILT;
KZ ← C_TILT;
END "MKROT1";
REAL SUBR DET3X3 (REAL ARRAY A,B,C);
RETURN(
+A[1]*(B[2]*C[3]-B[3]*C[2])
-A[2]*(B[1]*C[3]-B[3]*C[1])
+A[3]*(B[1]*C[2]-B[2]*C[1]) );
SUBR MKPTS;
BEGIN "MKPTS"
REAL TMP;
TILT ← ACOS(KZ); TMP ← 1/SIN(TILT);
PAN ← ATAN2(KX*TMP,-KY*TMP);
SWING ← ACOS(JZ*TMP);
END "MKPTS";
SUBR PRNPTS;
OUTSTR(9&"PAN = "&CVG(180*PAN/π)&
9&"TILT = "&CVG(180*TILT/π)&
9&"SWING = "&CVG(180*SWING/π)&↓);
PROCEDURE MKROT2 (ITG V1,V2,V3);
BEGIN "MKROT2"
REAL ARRAY X,Y,Z,XX,YY,ZZ[1:3];
REAL R; INTEGER I,J;
α PICK UP AND NORMALIZE WORLD & IMAGE VECTORS;
I←0;
FOR J←V1,V2,V3 DO
BEGIN
I ← I+1;
X[I] ← XWC[J] - CX; Y[I] ← YWC[J] - CY; Z[I] ← ZWC[J] - CZ;
R ← 1/SQRT(X[I]↑2 + Y[I]↑2 + Z[I]↑2);
X[I] ← X[I]*R; Y[I] ← Y[I]*R; Z[I] ← Z[I]*R;
R ← 1/SQRT(XCF[J]↑2 + YCF[J]↑2 + ZCF[J]↑2);
XX[I] ← XCF[J]*R; YY[I] ← YCF[J]*R; ZZ[I] ← ZCF[J]*R;
END;
R ← 1/DET3X3 ( X, Y, Z);
IX ← DET3X3(XX, Y, Z)*R;IY ← DET3X3( X,XX, Z)*R;IZ ← DET3X3( X, Y,XX)*R;
JX ← DET3X3(YY, Y, Z)*R;JY ← DET3X3( X,YY, Z)*R;JZ ← DET3X3( X, Y,YY)*R;
KX ← DET3X3(ZZ, Y, Z)*R;KY ← DET3X3( X,ZZ, Z)*R;KZ ← DET3X3( X, Y,ZZ)*R;
α NORMALIZE;
R ← 1/SQRT(IX↑2+IY↑2+IZ↑2);IX←IX*R;IY←IY*R;IZ←IZ*R;
R ← 1/SQRT(JX↑2+JY↑2+JZ↑2);JX←JX*R;JY←JY*R;JZ←JZ*R;
R ← 1/SQRT(KX↑2+KY↑2+KZ↑2);KX←KX*R;KY←KY*R;KZ←KZ*R;
WHILE TRUE DO
BEGIN "ORTHO"
REAL COSIJ,COSIK,COSJK,IERR,JERR,KERR;ITG I;
COSIJ ← IX*JX + IY*JY + IZ*JZ;
COSIK ← IX*KX + IY*KY + IZ*KZ;
COSJK ← JX*KX + JY*KY + JZ*KZ;
IERR ←ABS(COSIJ) + ABS(COSIK);
JERR ←ABS(COSIJ) + ABS(COSJK);
KERR ←ABS(COSIK) + ABS(COSJK);
IF IERR>JERR ∧ IERR>KERR THEN I←0;
IF JERR>IERR ∧ JERR>KERR THEN I←1;
IF KERR>IERR ∧ KERR>JERR THEN I←2;
IF (CASE I OF(IERR,JERR,KERR))≤0.001 THEN DONE;
CASE I OF BEGIN
⊂ IX← JY*KZ-JZ*KY;IY← JZ*KX-JX*KZ;IZ← JX*KY-JY*KX;⊃;
⊂ JX← KY*IZ-KZ*IY;JY← KZ*IX-KX*IZ;JZ← KX*IY-KY*IX;⊃;
⊂ KX← IY*JZ-IZ*JY;KY← IZ*JX-IX*JZ;KZ← IX*JY-IY*JX;⊃;END;
END "ORTHO";
MKPTS;PRNPTS;
END "MKROT2";
SUBR PROJECT;
BEGIN "PROJECT"
ITG I;
FOR I←1 THRU QCNT DO
BEGIN
REAL X,Y,Z,SX,SY;
α WC → CC WORLD LOCII PREDICTED;
X ← XWC[I] - CX;
Y ← YWC[I] - CY;
Z ← ZWC[I] - CZ;
XCC[I] ← X*IX + Y*IY + Z*IZ;
YCC[I] ← X*JX + Y*JY + Z*JZ;
ZCC[I] ← X*KX + Y*KY + Z*KZ;
α CC → PP;
SX ← -FOCAL/PDX;
SY ← -FOCAL/PDY;
XPP[I] ← SX * XCC[I] / ZCC[I];
YPP[I] ← SY * YCC[I] / ZCC[I];
α PP → DC;
XDC[I] ← MAG * (XPP[I]+(CPA-144));
YDC[I] ← MAG * (YPP[I]+(RPA-108));
END;
END "PROJECT";
SUBR UNPROJECT(REAL FOCAL);
BEGIN "UNPROJECT"
ITG I;
FOR I←1 THRU QCNT DO
BEGIN
XCF[I] ← PRXPP[I]*PDX;
YCF[I] ← PRYPP[I]*PDY;
ZCF[I] ← -FOCAL;
END;
END "UNPROJECT";
SUBR SHOW;
BEGIN "SHOW"
ITG I,X,Y;
DPYSET(DPYBUF);DPYBIG(2);
AIVECT(300,480);DPYSST("PAN "&CVS(PAN*180/π+0.5));
AIVECT(300,455);DPYSST("TILT "&CVS(TILT*180/π+0.5));
AIVECT(300,430);DPYSST("SWING "&CVS(SWING*180/π+0.5));
AIVECT(300,375);DPYSST("CX = "&CVG(CX));
AIVECT(300,350);DPYSST("CY = "&CVG(CY));
AIVECT(300,325);DPYSST("CZ = "&CVG(CZ));
AIVECT(300,250);DPYSST("PDX = "&CVG(PDX));
AIVECT(300,225);DPYSST("PDY = "&CVG(PDY));
AIVECT(300,200);DPYSST("FOCAL = "&CVG(FOCAL));
AIVECT(300,150);DPYSST("RPA = "&CVG(RPA));
AIVECT(300,125);DPYSST("CPA = "&CVG(CPA));
DPYBIG(1);
FOR I←1 THRU QCNT DO
IF ZCC[I]≤0 ∧ ABS(XDC[I])≤511 ∧ ABS(YDC[I])≤511 THEN
BEGIN
X ← XDC[I];Y ← YDC[I];
AIVECT(X-7,Y-7); AVECT(X+7,Y+7);
AIVECT(X+7,Y-7); AVECT(X-7,Y+7);
AIVECT(X,Y);DPYSST(CVS(I));
END;
DPYOUT(1);
END "SHOW";
α CRE LINKS & DATUMS;
α DECLARE CRE LINKS;
DEFINE CW(Q) = "(NODE[Q+0]LSH -18)";
DEFINE CCW(Q) = "(NODE[Q+0]LAND '777777)";
DEFINE DAD(Q) = "(NODE[Q+1]LSH -18)";
DEFINE SON(Q) = "(NODE[Q+1]LAND '777777)";
DEFINE ROW(Q) = "((NODE[Q+3]LSH -18)/64)";
DEFINE COL(Q) = "((NODE[Q+3]LAND '777777)/64)";
DEFINE ALT(Q) = "(NODE[Q+4]LSH -18)";
REAL SUBR AREA (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,1(2);⊃;
REAL SUBR PERM (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,1(2);⊃;
REAL SUBR PXY (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,4(2);⊃;
REAL SUBR MXX (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HLLE 1,6(2);⊃;
REAL SUBR MYY (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,6(2);⊃;
REAL SUBR MZZ (ITG SHAPE); S⊂ MOVE 2,SHAPE;ADD 2,ORIG;HRLE 1,4(2);⊃;
REAL SUBR PHI (ITG S); RETURN(0.5*ATAN2(MYY(S)-MXX(S),2*PXY(S)));
SUBR INERTIA;
BEGIN "INERTIA"
ITG I;
REAL A,X,Y,MX,MY,PR,C,S;
REAL A0,X0,Y0,MXX0,MYY0,PXY0;
REAL R1,R2,DR,C1,C2,DC;
α FIRST VERTEX;
A0←X0←Y0←MXX0←MYY0←PXY0←0; I←0;
R2 ← PRROW[1]; C2 ← PRCOL[1];
FOR I←QCNT STEP -1 UNTIL 1 DO
BEGIN
R1 ← R2; C1 ← C2;
R2 ← PRROW[I]; C2 ← PRCOL[I];
DR ← R2-R1; DC ← C2-C1;
α CONTRIBUTION OF TRIANGULAR PART;
A ← DC*DR/2; PR ← -A*A/18;
X ← (2*C2 + C1)/3; Y ← (2*R1 + C2)/3;
MX ← A*DR*DR/18; MY ← A*DC*DC/18;
α ACCUMULATE;
A0 ← A0 + A; PXY0 ← PXY0 + PR - X*Y*A;
X0 ← X0 + X*A; Y0 ← Y0 + Y*A;
MYY0 ← MYY0 + MY + X*X*A; MXX0 ← MXX0 + MX + Y*Y*A;
α CONTRIBUTION OF RECTANGULAR PART;
A ← DC*R1; PR ← 0;
X ← (C1+C2)/2; Y ← R1/2;
MX ← A*R1*R1/12; MY ← A*DC*DC/12;
α ACCUMULATE;
A0 ← A0 + A; PXY0 ← PXY0 + PR - X*Y*A;
X0 ← X0 + X*A; Y0 ← Y0 + Y*A;
MYY0 ← MYY0 + MY + X*X*A; MXX0 ← MXX0 + MX + Y*Y*A;
END;
ORBAREA ← A0;
ORBCOL ← X ← X0/A0;
ORBROW ← Y ← Y0/A0;
MXX0 ← MXX0/A0 - Y*Y;
MYY0 ← MYY0/A0 - X*X;
PXY0 ← PXY0/A0 + X*Y;
ORBARC ← 0.5*ATAN2(2*PXY0,MYY0-MXX0);
C ← COS(ORBARC); S ← SIN(ORBARC);
ORBMXX ← C*C*MXX0 + S*S*MYY0 - 2*C*S*PXY0;
ORBMYY ← C*C*MYY0 + S*S*MXX0 + 2*C*S*PXY0;
ORBPXY ← (C*C-S*S)*PXY0 + C*S*(MXX0 - MYY0);
ORBA ← 2*SQRT(ORBMYY);
ORBB ← ORBAREA/(π*ORBA);
END "INERTIA";
SUBR ESTIMATE;
BEGIN "ESTIMATE"
ITG I,J,K;
REAL QMAX,QMIN,QMED,Q;
α FIND THE EXTREMA DIAMETERS OF THE ORBIT;
QMAX ← 0; QMIN ← 99999;
FOR I←1 THRU QCNT%2 DO ⊂
Q ← SQRT((PRROW[I]-PRROW[I+QCNT%2])↑2 + (PRCOL[I]-PRCOL[I+QCNT%2])↑2);
IF Q>QMAX THEN ⊂ QMAX ← Q;J←I; ⊃;
IF Q<QMIN THEN ⊂ QMIN ← Q;K←I; ⊃; ⊃;
ORBMIN ← 0.5*QMIN;
ORBMAX ← 0.5*QMAX;
α ESTIMATE THE RADIUS OF THE BILLARD BALL'S TURN TABLE ORBIT;
ORBRAD ← ORBMAX*1.125/RADIUS[J];
OUTSTR("ESTIMATED ORBIT RADIUS = "&CVG(ORBRAD)&↓);
QMED ← RADIUS[J];
α ESTIMATE THE CAMERA'S PAN;
QMAX ← 0; QMIN ← 99999;
FOR I←1 THRU QCNT DO
BEGIN
IF QMIN>RADIUS[I] THEN ⊂ J←I;QMIN←RADIUS[I]; ⊃;
IF QMAX<RADIUS[I] THEN ⊂ QMAX←RADIUS[I]; ⊃;
END;
α ESTIMATE THE FOCAL PLANE DISTANCE;
EFOCAL ← 2*ORBMAX*QMIN*QMAX/((QMAX-QMIN)*QMED*PDY);
OUTSTR("ESTIMATED FOCAL = "&CVG(EFOCAL)&" MILLIMETERS."&↓);
END "ESTIMATE";
SUBR PDPY (ITG PGN); α POLYGON DISPLAY;
BEGIN "PDPY"
REAL R,C,X,Y;
ITG V0,V,S;
α TEST SHAPE NODE FOR QUEUE BALL OUTLINE;
S ← ALT(PGN);
IF AREA(S)≤600 ∨ AREA(S)≥1800 THEN RETURN;
SNODE[CNT] ← S;
α SAVE & DISPLAY QUE BALL PROPERTIES;
R ← PRROW[CNT] ← ROW(S);
C ← PRCOL[CNT] ← COL(S);
PRXPP[CNT] ← C - 144;
PRYPP[CNT] ← 108 - R;
PRXDC[CNT] ← X ← MAG*(C-CPA);
PRYDC[CNT] ← Y ← MAG*(RPA-R);
AIVECT(X,Y);DPYSST(CVS(CNT));
AIVECT(X-15,Y); AVECT(X+10,Y);
AIVECT(X,Y-15); AVECT(X,Y+10);
R ← RADIUS[CNT] ← SQRT(AREA(S)/π);
RETURN;
α POLYGONS PERMETER;
V ← V0 ← SON(PGN);
AIVECT(MAG*(COL(V)-144),MAG*(108-ROW(V)));
DO BEGIN
V ← CCW(V);
AVECT(MAG*(COL(V)-144),MAG*(108-ROW(V)));
END UNTIL V=V0;
END "PDPY";
SUBR FDPY; α FILM DISPLAY;
BEGIN "FDPY"
ITG F,I0,I;
ITG L0,L,P0,P;
DPYSET(DPYBUF);
CNT ← 0;
DPYBIG(1);
AIVECT(-511,-MAG*108);
AVECT(+511,-MAG*108);
AVECT(+511,+MAG*108);
AVECT(-511,+MAG*108);
AVECT(-511,-MAG*108);
F ← 0;
I0 ← I ← SON(F);
DO BEGIN "IMGDPY" α IMAGE DISPLAY;
CNT←CNT+1;
L0 ← L ← SON(I);
L ← CCW(L);
P0 ← P ← SON(L);
DO PDPY(P) UNTIL P0=(P←CCW(P));
END "IMGDPY" UNTIL I0=(I←CCW(I));
DPYOUT(0);
QCNT ← CNT;
END "FDPY";
SUBR ORBINIT(REAL RAD); α WORLD LOCUS OF THE QUEUE BALLS;
BEGIN "ORBINIT"
STRING STR;REAL Z;ITG CHR;
C ← COS(-2*π/QCNT);
S ← SIN(-2*π/QCNT);
XWC[1] ← -5.77;
YWC[1] ← 0;
OUTSTR("HEIGHT OF TOP OF QUE BALL ABOVE TABLE IN INCHES = ");
STR←INCHWL;
Z ← REALSCAN(STR,CHR);
ZWC[1] ← Z - 2.25/2;
FOR I←2 THRU QCNT DO
⊂ XWC[I] ← C*XWC[I-1] - S*YWC[I-1];
YWC[I] ← S*XWC[I-1] + C*YWC[I-1];
ZWC[I] ← ZWC[I-1]; ⊃;
END "ORBINIT";
α MAIN EXECUTION;
REAL DEL,SD;
α ESTIMATED CAMERA;
RPA ← 108; CPA ← 144;
CX ← 41; CY ← -12; CZ ← 23;
PAN ← 72*π/180; TILT ← 65*π/180; SWING ← 2*π/180;
MAG ← 32/9; FOCAL ← 32000;
PDX ← 38.78; PDY ← 40.0;
MKROT1;
α INPUT CRE NODES;
OUTSTR(12&12&12&12); α SCROLL THE PAGE PRINTER;
NODE[0] ← SIZE;
ARRYIN(1,NODE[1],SIZE-1);
ORIG ← LOCATION(NODE[0]);
RELEASE(1);OUTSTR(9&"EOF."&↓);
FDPY;
INERTIA;
ESTIMATE;
ORBINIT(ORBRAD); α ORBIT INITIALIZATION;
PROJECT;
SHOW;
WHILE TRUE DO
BEGIN
STRING STR; ITG CHR;
OUTSTR(CVG(SQRT(CX↑2+CY↑2))&9&CVG(SQRT(CX↑2+CY↑2+CZ↑2))&↓);
OUTSTR("FOCAL IN MM = ");
STR ← INCHWL;
IF LENGTH(STR)=0 THEN DONE;
FOCAL ← 1000*REALSCAN(STR,CHR);
UNPROJECT(FOCAL);
CAMCNT ← 0;
IF TRUE THEN ⊂
LSCAM(2,24,10);LSCAM(3,27,12);LSCAM(6,28,14);
LSCAM(8,30,16);LSCAM(10,31,17);LSCAM(13,1,20);
⊃ ELSE ⊂
LSCAM(1,12,5);LSCAM(2,13,6);LSCAM(3,14,7);
LSCAM(4,15,8);LSCAM(5,16,9);LSCAM(6,1,10);LSCAM(7,2,11);
⊃;
CAMERR;
MKROT2(2,24,10);MKROT2(4,26,12);MKROT2(6,28,14);
MKROT2(8,30,16);MKROT2(10,31,17);MKROT2(13,1,20);
MKPTS; α MAKE PAN-TILT-SWING;
PROJECT;
SHOW;
END;
WHILE TRUE DO
BEGIN "OUTCAM"
INTERNAL REAL ARRAY TMP[0:10];
STRING STR;
ITG FLG;
REAL METERS,MICRON;
METERS ← 0.3048006/12; α METERS PER INCH;
MICRON ← 0.000001;
α CAMERA LOCATION & ORIENTATION & SCALE;
TMP[0]← CX*METERS; TMP[1]← CY*METERS; TMP[2]← CZ*METERS;
TMP[3]← PAN; TMP[4]← TILT; TMP[5]← SWING;
TMP[6]← PDX*MICRON; TMP[7]← PDY*MICRON; TMP[8]← PDY*MICRON;
TMP[9]← FOCAL*MICRON;
OPEN(1,"DSK",8,0,1,0,0,0);
OUTSTR("CAMERA FILE NAME = ");STR←INCHWL;
IF LENGTH(STR)=0 THEN DONE;
ENTER(1,STR&".CAM",FLG);
IF FLG THEN ⊂ OUTSTR("ENTER FAILED."&↓);DONE;⊃;
ARRYOUT(1,TMP[0],10);RELEASE(1);OUTSTR(9&"EOF"&↓);
DONE;
END "OUTCAM";
WHILE TRUE DO INCHRW;
END "MAIN"
END "QBALL";